home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / MIME / QuotedPrint.pm < prev   
Encoding:
Perl POD Document  |  1999-12-28  |  2.4 KB  |  93 lines
  1.  
  2. package MIME::QuotedPrint;
  3.  
  4. =head1 NAME
  5.  
  6. encode_qp - Encode string using quoted-printable encoding
  7.  
  8. decode_qp - Decode quoted-printable string
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.  use MIME::QuotedPrint;
  13.  
  14.  $encoded = encode_qp($decoded);
  15.  $decoded = decode_qp($encoded);
  16.  
  17. =head1 DESCRIPTION
  18.  
  19. This module provides functions to encode and decode strings into the
  20. Quoted-Printable encoding specified in RFC 2045 - I<MIME (Multipurpose
  21. Internet Mail Extensions)>.  The Quoted-Printable encoding is intended
  22. to represent data that largely consists of bytes that correspond to
  23. printable characters in the ASCII character set.  Non-printable
  24. characters (as defined by english americans) are represented by a
  25. triplet consisting of the character "=" followed by two hexadecimal
  26. digits.
  27.  
  28. Note that the encode_qp() routine does not change newlines C<"\n"> to
  29. the CRLF sequence even though this might be considered the right thing
  30. to do (RFC 1521 (Q-P Rule #4)).
  31.  
  32. If you prefer not to import these routines into your namespace you can
  33. call them as:
  34.  
  35.   use MIME::QuotedPrint ();
  36.   $encoded = MIME::QuotedPrint::encode($decoded);
  37.   $decoded = MIME::QuotedPrint::decode($encoded);
  38.  
  39. =head1 COPYRIGHT
  40.  
  41. Copyright 1995-1997 Gisle Aas.
  42.  
  43. This library is free software; you can redistribute it and/or
  44. modify it under the same terms as Perl itself.
  45.  
  46. =cut
  47.  
  48. use strict;
  49. use vars qw(@ISA @EXPORT $VERSION);
  50.  
  51. require Exporter;
  52. @ISA = qw(Exporter);
  53. @EXPORT = qw(encode_qp decode_qp);
  54.  
  55. $VERSION = sprintf("%d.%02d", q$Revision: 2.2 $ =~ /(\d+)\.(\d+)/);
  56.  
  57.  
  58. sub encode_qp ($)
  59. {
  60.     my $res = shift;
  61.     $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;  # rule #2,#3
  62.     $res =~ s/([ \t]+)$/
  63.       join('', map { sprintf("=%02X", ord($_)) }
  64.            split('', $1)
  65.       )/egm;                        # rule #3 (encode whitespace at eol)
  66.  
  67.     my $brokenlines = "";
  68.     $brokenlines .= "$1=\n"
  69.     while $res =~ s/(.*?^[^\n]{73} (?:
  70.          [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n
  71.         |[^=\n]    (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n
  72.         |          (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n
  73.         ))//xsm;
  74.  
  75.     "$brokenlines$res";
  76. }
  77.  
  78.  
  79. sub decode_qp ($)
  80. {
  81.     my $res = shift;
  82.     $res =~ s/[ \t]+?(\r?\n)/$1/g;  # rule #3 (trailing space must be deleted)
  83.     $res =~ s/=\r?\n//g;            # rule #5 (soft line breaks)
  84.     $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
  85.     $res;
  86. }
  87.  
  88.  
  89. *encode = \&encode_qp;
  90. *decode = \&decode_qp;
  91.  
  92. 1;
  93.